home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO003.dsk / FILE.CABINET.bas < prev    next >
BASIC Source File  |  2012-02-16  |  18KB  |  513 lines
  1. 1000  REM START OF PROGRAM
  2. 1010 D$ =  CHR$(4)
  3. 1020  TEXT : HOME 
  4. 1030  GOSUB 6010
  5. 1040  CLEAR 
  6. 1050  DIM R$(65),AC(22),K(65),H$(21),RN$(21)
  7. 1060  DIM Z$(21)
  8. 1070 COMMA$ = "NO"
  9. 1080 I$ =  CHR$(9)
  10. 1090 D$ =  CHR$(4)
  11. 1100 H$(0) = "REC#"
  12. 1110  REM  -READ SYSTEM DATE
  13. 1120 MO$ = "???JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
  14. 1130 DD =  PEEK(49040) - INT( PEEK(49040)/32) *32
  15. 1140 YY =  INT( PEEK(49041)/2)
  16. 1150 MM = ( PEEK(49041) -YY *2) *8 + INT( PEEK(49040)/32)
  17. 1160 MM$ =  MID$ (MO$,MM *3 +1,3)
  18. 1170 DB$ = "":F$ = "BASENAME": ONERR  GOTO 2820
  19. 1180  GOSUB 4890
  20. 1190  GOTO 2680
  21. 1200 F$ = ".H": ONERR  GOTO 1600
  22. 1210  GOSUB 4890
  23. 1220  FOR I = 1 TO NR:H$(I) = R$(I): NEXT I
  24. 1230 NH = NR:NR = 0: PRINT  CHR$(4)"FRE":MEM = ( PEEK(111) + PEEK(112) *256) -( PEEK(109) + PEEK(110) *256)
  25. 1240 B =  INT(MEM/((13 *NH) +5))
  26. 1250  DIM N$(B,NH),R(B)
  27. 1260 F$ = ".I": ONERR  GOTO 5600
  28. 1270  GOSUB 4890
  29. 1280  GOTO 5580
  30. 1290  REM *** SORT ***
  31. 1300 N = NR:M = N
  32. 1310 M =  INT(M/2):K = N -M:J = 1: PRINT "SORTING ";: IF M = 0  THEN  PRINT "DONE": GOTO 1500
  33. 1320 I = J
  34. 1330 LL = I +M:I2 = R(I):L2 = R(LL): ON L GOTO 1350: IF  VAL(N$(I2,S)) < =  VAL(N$(L2,S))  THEN 1370
  35. 1340  GOTO 1360
  36. 1350  IF N$(I2,S) < = N$(L2,S)  THEN 1370
  37. 1360 Y = R(I):R(I) = R(LL):R(LL) = Y:I = I -M: IF I > = 1  THEN 1330
  38. 1370 J = J +1: IF J >K  THEN 1310
  39. 1380  GOTO 1320
  40. 1390  PRINT "SORTING ";
  41. 1400  FOR I = NR TO 1  STEP  -1: FOR J = NR TO 1  STEP  -1
  42. 1410  IF I < >J  THEN  IF R(I) = R(J)  THEN R(J) = R(J) -1
  43. 1420  NEXT J: NEXT I
  44. 1430  PRINT "SORTING "
  45. 1440 J = 1
  46. 1450  IF R(J) = J  THEN J = J +1: GOTO 1450
  47. 1460  IF J > = NR  THEN 1500
  48. 1470  FOR I = 1 TO NH:Z$(I) = N$(R(J),I):N$(R(J),I) = N$(J,I):N$(J,I) = Z$(I): NEXT I
  49. 1480 Z = R(R(J)):R(R(J)) = R(J):R(J) = Z
  50. 1490  GOTO 1450
  51. 1500 F$ = ".I": GOSUB 5060: GOSUB 4890
  52. 1510  GOTO 5580
  53. 1520 MF = 1: GOSUB 4640
  54. 1530  INPUT "ENTER # OF FIELD FOR SORT ";S$:S =  VAL(S$): IF S <1  OR S >NH  THEN 1530
  55. 1540  PRINT : PRINT "DO YOU WANT TO SORT:": PRINT 
  56. 1550  PRINT "1 ALPHABETICALLY"
  57. 1560  PRINT "2 NUMERICALLY"
  58. 1570  PRINT 
  59. 1580  INPUT "WHICH ";L$:L =  VAL(L$)
  60. 1590  PRINT : PRINT "SORTING ";: GOTO 1300
  61. 1600  PRINT D$"CLOSE": CALL 1013: REM     *** CREATE HEADERFILE ***
  62. 1610  POKE 216,0
  63. 1620 NR = 1
  64. 1630  HOME : PRINT "PRESS 'RETURN' TO EXIT TO MENU"
  65. 1640  PRINT 
  66. 1650  PRINT "HEADER FOR COLUMN NUMBER "NR": ";: INPUT "";R$(NR)
  67. 1660  IF R$(NR) = ""  OR NR >20  THEN 1690
  68. 1670 NR = NR +1
  69. 1680  GOTO 1650
  70. 1690 NR = NR -1
  71. 1700  GOSUB 5060: GOTO 1220
  72. 1710  REM ***ENTER RECORDS***
  73. 1720  HOME 
  74. 1730  REM 
  75. 1740  PRINT "YOU HAVE ?????";: GOSUB 8000
  76. 1750  HTAB 10: PRINT FM" BYTES OF MEMORY LEFT"
  77. 1760  PRINT "IN THE "DB$" FILE"
  78. 1780 NR = NR +1:R(NR) = NR
  79. 1790  PRINT "YOU ARE ENTERING RECORD # "NR
  80. 1800  PRINT 
  81. 1810  FOR I = 1 TO NH
  82. 1820  PRINT H$(I);: INPUT ": ";N$(NR,I)
  83. 1840  NEXT I
  84. 1850  PRINT : PRINT "MORE (Y/N)"
  85. 1860  INPUT "DEFAULT IS Y ";L$
  86. 1870  IF L$ = "Y"  OR L$ = ""  THEN 1730
  87. 1880 F$ = ".I"
  88. 1890  GOSUB 5060
  89. 1900  GOTO 5580
  90. 1910  REM ***SEARCH/CHANGE***
  91. 1920 L = 0
  92. 1930  HOME 
  93. 1940  PRINT "YOU MAY SEARCH BY ANY OF THE FOLLOWING:"
  94. 1950  PRINT 
  95. 1960  GOSUB 4640
  96. 1970  PRINT : PRINT "OR YOU MAY": PRINT 
  97. 1980  PRINT I" MAKE CHANGES"
  98. 1990  PRINT 
  99. 2000  INPUT "WHICH ";S$:S =  VAL(S$)
  100. 2010  IF S <0  OR S >NH +1  THEN 2000
  101. 2020  IF S = NH +1  THEN 2250
  102. 2030  HOME 
  103. 2040  PRINT "PLEASE ENTER THE "H$(S): PRINT "YOU WANT TO FIND.......<CTRL-J>": INPUT "";Q$
  104. 2050  HOME 
  105. 2060  FOR J = 1 TO NR:Y = R(J)
  106. 2070 N$(Y,0) =  STR$(J)
  107. 2080  IF  LEFT$(N$(Y,S), LEN(Q$)) = Q$  THEN  GOSUB 2420
  108. 2090  IF L +NH >20  THEN  GOSUB 2190
  109. 2100  NEXT J
  110. 2110  PRINT "THAT'S ALL OF THEM. ";
  111. 2120  PRINT "NOW YOU MAY:"
  112. 2130  PRINT "1 DO MORE SEARCHES"
  113. 2140  PRINT "2 MAKE CHANGES"
  114. 2150  PRINT "3 RETURN TO THE MAIN MENU"
  115. 2160  INPUT "<CTRL-J>WHICH ";S$:S =  VAL(S$)
  116. 2170  IF S <1  OR S >3  THEN 2160
  117. 2180  ON S GOTO 1930,2250,5580
  118. 2190  IF PF < >0  THEN 2240
  119. 2200  PRINT "PRESS RETURN TO CONTINUE, ESC FOR MENU";
  120. 2210  GET L$
  121. 2220  IF  ASC(L$) = 27  THEN 5580
  122. 2230  IF  ASC(L$) < >13  THEN 2210
  123. 2240 L = 0: HOME : RETURN 
  124. 2250  REM ***CHANGE DATA***
  125. 2260  PRINT "<CTRL-J>ENTER THE NUMBER OF THE RECORD"
  126. 2270  INPUT "YOU WANT TO CHANGE ";J$:J =  VAL(J$):Y = R(J)
  127. 2280  IF J <1  OR J >NR  THEN 2260
  128. 2290  HOME : GOSUB 2420
  129. 2300  PRINT "<CTRL-J>ENTER THE NUMBER OF THE FIELD YOU WANT": PRINT "TO CHANGE ";
  130. 2310  INPUT "";S$:S =  VAL(S$)
  131. 2320  IF S <1  OR S >NH  THEN 2300
  132. 2330  PRINT 
  133. 2340  PRINT "FROM ";H$(S);": ";N$(Y,S)
  134. 2350  PRINT 
  135. 2360  PRINT "TO "H$(S)": ";: INPUT "";N$(Y,S)
  136. 2370  HOME : GOSUB 2420
  137. 2380  PRINT 
  138. 2390  INPUT "<CTRL-J>MORE CHANGES (Y/N) ";L$
  139. 2400  IF L$ = "Y"  THEN 2250
  140. 2410 F$ = ".I": GOSUB 5060: GOTO 5580
  141. 2420  REM ***PRINT A RECORD***
  142. 2430  ON PF GOSUB 6060,6080
  143. 2440  PRINT "  "H$(0)": ";J
  144. 2450  FOR I = 1 TO NH
  145. 2460  PRINT I" "H$(I)": "N$(Y,I)
  146. 2470  NEXT I
  147. 2480  PRINT 
  148. 2490 L = L +NH +2
  149. 2500  PRINT D$"PR#0"
  150. 2510  RETURN 
  151. 2520  REM ***DELETE RECORDS***
  152. 2530  HOME 
  153. 2540  PRINT "ENTER 0 TO STOP DELETING"
  154. 2550  INPUT "ENTER RECORD NUMBER YOU WANT DELETED ";DR$:DR =  VAL(DR$)
  155. 2560  IF DR = 0  THEN  GOTO 2670
  156. 2570  IF DR <1  OR DR >NR  THEN 2550
  157. 2580  FOR J = DR TO NR -1
  158. 2590  FOR I = 1 TO NH
  159. 2600 N$(J,I) = N$(J +1,I)
  160. 2610  NEXT I
  161. 2620  NEXT J
  162. 2630 NR = NR -1
  163. 2640  PRINT : PRINT "RECORD NUMBER "DR" DELETED!": PRINT 
  164. 2650  INPUT "MORE (Y/N) ";L$
  165. 2660  IF L$ = "Y"  THEN 2550
  166. 2670 F$ = ".I": GOSUB 5060: GOTO 5580
  167. 2680  REM   *** BASENAMEFILE ROUTINES ***
  168. 2690  HOME 
  169. 2700  PRINT "SELECT FROM:": PRINT 
  170. 2710  FOR J = 1 TO NR: PRINT J" "R$(J): NEXT J: PRINT 
  171. 2720  PRINT J" CREATE A NEW DATA BASE"
  172. 2730  IF J >1  THEN  PRINT J +1" DELETE A DATA BASE"
  173. 2740  PRINT 
  174. 2750  INPUT "WHICH ";S$:S =  VAL(S$)
  175. 2760  IF S = J +1  THEN 2920
  176. 2770  IF S <1  OR S >J  THEN  PRINT  CHR$(7);: VTAB  PEEK(37): CALL  -868: GOTO 2750
  177. 2780 DB$ = R$(S)
  178. 2790  IF S < >J  THEN 1200
  179. 2800  PRINT 
  180. 2810  GOTO 2830
  181. 2820  PRINT D$"CLOSE": CALL 1013
  182. 2830  IF J = 0  THEN J = 1
  183. 2840  PRINT "NAME FOR NEW DATA BASE FILE": INPUT "SIX CHARACTERS MAXIMUM: ";R$(J)
  184. 2850  IF  LEN(R$(J)) >6  OR  LEFT$(R$(J),1) <"A"  OR  LEFT$(R$(J),1) >"Z"  THEN 2840
  185. 2860 I = 1
  186. 2870  IF ( MID$ (R$(J),I,1) = ".")  OR ( MID$ (R$(J),I,1) >"/"  AND  MID$ (R$(J),I,1) <":")  OR ( MID$ (R$(J),I,1) >"@"  AND  MID$ (R$(J),I,1) < CHR$(91))  THEN 2890
  187. 2880  GOTO 2840
  188. 2890 I = I +1: IF I < =  LEN(R$(J))  THEN 2870
  189. 2900 NR = J: GOSUB 5060
  190. 2910 DB$ = R$(J -1): GOTO 1200
  191. 2920  REM      *** DELETE A DATA BASE ***
  192. 2930  PRINT : INPUT "DELETE WHICH : ";S$:S =  VAL(S$)
  193. 2940  IF S <1  OR S >J -1  THEN  PRINT  CHR$(7);: VTAB  PEEK(37) -1: CALL  -868: GOTO 2930
  194. 2950  HOME : VTAB (9): PRINT "READY TO DELETE " CHR$(34);R$(S); CHR$(34);".": PRINT 
  195. 2960  PRINT "ONCE DELETED, THIS DATA CANNOT BE"
  196. 2970  PRINT "RECOVERED.  ARE YOU SURE THAT YOU"
  197. 2980  PRINT "WANT TO DELETE IT? (Y/N) ";: INPUT "";S$
  198. 2990  IF S$ < >"Y"  THEN 2680
  199. 3000  HOME : VTAB 12: HTAB 11: INVERSE : PRINT  CHR$(91);" DELETING DATABASE ]": NORMAL 
  200. 3010  ONERR  GOTO 3130
  201. 3020 DB$ = R$(S)
  202. 3030 F$ = ".F"
  203. 3040  GOSUB 4890
  204. 3050  PRINT D$;"OPEN";DB$;F$;"F": PRINT D$"CLOSE"
  205. 3060  PRINT D$;"DELETE";DB$;F$;"F"
  206. 3070  FOR I = 1 TO NR
  207. 3080  PRINT D$;"OPEN";DB$;R$(I);".RF": PRINT D$"CLOSE"
  208. 3090  PRINT D$;"DELETE";DB$;R$(I);".RF"
  209. 3100  NEXT I
  210. 3110  GOTO 2840
  211. 3120  REM 
  212. 3130  PRINT D$"CLOSE": PRINT D$"OPEN";DB$;".FF": PRINT D$"CLOSE": CALL 1013: PRINT D$"DELETE"DB$".FF"
  213. 3140  PRINT D$;"OPEN";DB$;".IF": PRINT D$"CLOSE"
  214. 3150  PRINT D$"DELETE"DB$".IF"
  215. 3160  PRINT D$;"OPEN";DB$".HF": PRINT D$"CLOSE"
  216. 3170  PRINT D$"DELETE"DB$".HF"
  217. 3180 DB$ = ""
  218. 3190 F$ = "BASENAME": GOSUB 4890
  219. 3200  IF NR = 1  THEN  PRINT D$"OPEN BASENAMEF": PRINT D$"CLOSE": PRINT D$;"DELETE BASENAMEF": GOTO 1000
  220. 3210  FOR I = S TO NR -1
  221. 3220 R$(I) = R$(I +1)
  222. 3230  NEXT I
  223. 3240 NR = NR -1: GOSUB 5060
  224. 3250  GOTO 2680
  225. 3260  REM ***REPORT***
  226. 3270 T9 = 0
  227. 3280  HOME :E = 0
  228. 3290  FOR I = 0 TO 3 *NH +2:K(I) = 0: NEXT I
  229. 3300  FOR I = 0 TO NH +1:AC(I) = 0: NEXT I:HC = 0:GT = 0
  230. 3310 PAGE = 0
  231. 3320  ON E GOTO 3540
  232. 3330  GOTO 4700
  233. 3340  IF NH <19  THEN  PRINT "=======================================": POKE 34,NH +5
  234. 3350  PRINT : INPUT "HOW MANY HEADERS ";RH$:RH =  VAL(RH$): IF RH <1  OR RH >NH +1  THEN 3350
  235. 3360  IF E = 0  THEN RN$(NN) = "PRESENT"
  236. 3370  FOR I = 1 TO RH *3  STEP 3
  237. 3380  PRINT 
  238. 3390  PRINT "ENTER # OF HEADER YOU WANT IN": PRINT "POSITION #"(I +2)/3" ";: INPUT "";K$:K(I) =  VAL(K$)
  239. 3400  IF K(I) <0  OR K(I) >NH  THEN 3390
  240. 3410  PRINT "ENTER TAB FOR "H$(K(I))" ";: INPUT "";K$:K(I +1) =  VAL(K$)
  241. 3420  IF I = 1  THEN 3440
  242. 3430  IF K(I +1) =  <K(I -2)  THEN 3410
  243. 3440  IF K(I +1) <0  OR K(I +1) >255  THEN 3410
  244. 3450  PRINT "TOTAL ON "H$(K(I))" (Y/N) ";: INPUT L$
  245. 3460  IF L$ = "Y"  THEN K(I +2) = 1:K(0) = 1
  246. 3470  NEXT I
  247. 3480  POKE 34,0
  248. 3490  IF K(0) < >1  THEN 3540
  249. 3500  PRINT 
  250. 3510  INPUT "ENTER TAB FOR TOTAL: ";A$
  251. 3520  IF  LEN(A$) = 0  THEN K(0) = 0:T9 = 1: GOTO 3540
  252. 3530 K(I +1) =  VAL(A$): IF K(I +1) <0  OR K(I +1) >131  THEN  PRINT "<CTRL-G>": VTAB  PEEK(37) -1: GOTO 3510
  253. 3540  PRINT 
  254. 3550 WIDE = K(3 *RH -1) + LEN(H$(K(3 *RH -2))): IF K(3 *RH +2) >0  THEN WIDE = K(3 *RH +2) +5
  255. 3560  IF PF <1  THEN  GOTO 3580
  256. 3570  ON PF GOTO 3580,3590,3600
  257. 3580  IF WIDE >40  THEN  PRINT "THIS FORMAT EXECEEDS 40 COLUMNS": GOTO 3620
  258. 3590  IF WIDE >80  THEN  PRINT "THIS FORMAT EXCEEDS 80 COLUMNS": GOTO 3620
  259. 3600  IF WIDE >132  THEN  PRINT "THIS FORMAT EXCEEDS 132 COLUMNS": GOTO 3620
  260. 3610  GOTO 3630
  261. 3620  INPUT "DO YOU WISH TO USE IT ANYWAY (Y/N) ";L$: IF L$ < >"Y"  THEN 3260
  262. 3630  INPUT "SELECT RECORDS BY WHICH HEADER # ";S$:S =  VAL(S$)
  263. 3640  IF  LEN(S$) = 0  THEN Q$ = "@": GOTO 3800
  264. 3650  IF S$ = "0"  THEN 3690
  265. 3660  FOR I = 1 TO NH: IF S = I  THEN 3690
  266. 3670  NEXT I
  267. 3680  GOTO 3630
  268. 3690  PRINT : INPUT "'AND' 2ND HEADER (Y/N) ";L$: IF L$ < >"Y"  THEN X$ = "@": GOTO 3760
  269. 3700  PRINT : INPUT "ENTER # OF 'AND' HEADER ";X$:X =  VAL(X$)
  270. 3710  IF  LEN(X$) = 0  THEN X$ = "@"
  271. 3720  IF X$ = "0"  THEN 3760
  272. 3730  FOR I = 1 TO NH: IF X = I  THEN 3760
  273. 3740  NEXT I
  274. 3750  GOTO 3700
  275. 3760  PRINT : PRINT "@ WILL SELECT ALL RECORDS."
  276. 3770  PRINT : PRINT "SELECT RECORDS FOR "H$(S)"= ";: INPUT "";Q$: PRINT 
  277. 3780  IF L$ = "Y"  THEN  PRINT "AND "H$(X)"= ";: INPUT "";X$
  278. 3790  IF  LEN(X$) = 0  THEN X$ = "@"
  279. 3800 WIDE = K(3 *RH -1) + LEN(H$(K(3 *RH -2))): IF K(3 *RH +2) >0  THEN WIDE = K(3 *RH +2) +5
  280. 3810  FOR I = 1 TO RH
  281. 3820  IF K(I *3) = 1  THEN T9 = 1
  282. 3830  NEXT I
  283. 3840  ON PF GOSUB 6060,6080,6110: GOSUB 4270
  284. 3850  FOR J = 1 TO NR:Y = R(J)
  285. 3860 N$(Y,0) =  STR$(J)
  286. 3870  IF Q$ = "@"  THEN 3930
  287. 3880  IF  LEN(Q$) = 0  THEN 3930
  288. 3890  IF  LEFT$(N$(Y,S), LEN(Q$)) < >Q$  THEN 3940
  289. 3900  IF X$ = "@"  THEN 3930
  290. 3910  IF  LEN(X$) = 0  THEN 3930
  291. 3920  IF  LEFT$(N$(Y,X), LEN(X$)) < >X$  THEN 3940
  292. 3930  GOSUB 4080
  293. 3940  IF PF <1  THEN  IF L >18  THEN  GOSUB 2190: GOSUB 4270
  294. 3950  REM  *** PAGINATION PATCH
  295. 3960  IF J <NR  AND L >58  THEN  FOR ZZ = 1 TO 8: PRINT " ": NEXT ZZ
  296. 3970  IF J <NR  AND L >58  THEN  GOSUB 4270
  297. 3980  IF L = 0  THEN  GOSUB 4270
  298. 3990  NEXT J
  299. 4000  ON T9 GOSUB 4200
  300. 4010  PRINT : PRINT D$;"PR#0"
  301. 4020  ON E GOTO 4050
  302. 4030  PRINT : PRINT "DO YOU WANT TO SAVE THE FORMAT": INPUT "FOR THIS REPORT TO DISK (Y/N) ";L$
  303. 4040  IF L$ = "Y"  THEN E = 1: GOSUB 4430
  304. 4050  PRINT : PRINT "MORE REPORTS USING THE "RN$(NN)" FORMAT": INPUT "(Y/N) ";L$
  305. 4060  IF L$ = "Y"  THEN  GOSUB 4640:E = 1: GOTO 3300
  306. 4070  GOTO 5580
  307. 4080  FOR I = 1 TO RH
  308. 4090  IF K(3 *I) = 1  THEN 4150
  309. 4100  POKE 36,K(3 *I -1): PRINT N$(J,K(3 *I -2));
  310. 4110  NEXT I
  311. 4120  IF K(0) = 1  AND HC < >0  THEN  POKE 36,K(3 *I -1) +5 - LEN( STR$(HC)): PRINT HC;:GT = GT +HC:HC = 0
  312. 4130 L = L +1
  313. 4140  PRINT : RETURN 
  314. 4150 N = 3 *I -2
  315. 4160  POKE 36,K(3 *I -1) + LEN(H$(K(N))) - LEN(N$(J,K(N))): PRINT N$(J,K(N));
  316. 4170 V =  VAL(N$(Y,K(N))):AC(I) = AC(I) +V:HC = HC +V
  317. 4180  GOTO 4110
  318. 4190  FOR Z = 1 TO WIDE: PRINT "-";: NEXT Z: PRINT : RETURN 
  319. 4200  GOSUB 4190
  320. 4210  FOR I = 1 TO RH
  321. 4220  IF AC(I) = 0  THEN 4240
  322. 4230  POKE 36,K(3 *I -1) + LEN(H$(K(3 *I -2))) - LEN( STR$(AC(I))): PRINT AC(I);
  323. 4240  NEXT I
  324. 4250  IF GT < >0  THEN  POKE 36,K(3 *I -1) +5 - LEN( STR$(GT)): PRINT GT;
  325. 4260  PRINT : RETURN 
  326. 4270  HOME 
  327. 4280  IF Q$ = "@"  THEN  PRINT RN$(NN);" REPORT (ALL RECORDS)";: GOTO 4320
  328. 4290  PRINT RN$(NN)" REPORT FOR "H$(S)"="Q$;
  329. 4300  IF X$ = "@"  THEN 4320
  330. 4310  PRINT " AND ";H$(X);"=";X$
  331. 4320 PAGE = PAGE +1:SPACE = WIDE - LEN(RN$(NN)) - LEN(H$(S)) -18: IF SPACE <1  THEN  PRINT : REM  TESTS IF PAGE # & TITLE OVER-PRINT
  332. 4330  IF WIDE <7  THEN WIDE = 7
  333. 4340  POKE 36,WIDE -6: PRINT "PAGE ";PAGE
  334. 4350  IF SPACE >0  THEN  PRINT 
  335. 4360  GOSUB 4190
  336. 4370  FOR I = 1 TO RH
  337. 4380  POKE 36,K(3 *I -1): PRINT H$(K(3 *I -2));
  338. 4390  NEXT I
  339. 4400  IF K(0) = 1  THEN  POKE 36,K(3 *I -1): PRINT "TOTAL";
  340. 4410  PRINT : GOSUB 4190
  341. 4420 L = 5: RETURN 
  342. 4430  REM   *** SET-UP TO SAVE RPTFMTFILE ***
  343. 4440 NS = NR
  344. 4450  PRINT : PRINT "ENTER THE REPORT FORMAT NAME": INPUT "SIX CHARACTERS MAXIMUM: ";RN$(NN)
  345. 4460  IF  LEN(RN$(NN)) >6  THEN 4450
  346. 4470 I = 1
  347. 4480  IF ( MID$ (RN$(NN),I,1) = ".")  OR ( MID$ (RN$(NN),I,1) >"/"  AND  MID$ (RN$(NN),I,1) <":")  OR ( MID$ (RN$(NN),I,1) >"@"  AND  MID$ (RN$(NN),I,1) < CHR$(91))  THEN 4500
  348. 4490  GOTO 4450
  349. 4500 I = I +1: IF I < =  LEN(RN$(NN))  THEN 4480
  350. 4510 F$ = RN$(NN) +".R"
  351. 4520 NR = 3 *RH +2
  352. 4530  FOR I = 1 TO NR:R$(I) =  STR$(K(I)): NEXT I
  353. 4540 R$(I -2) =  STR$(K(0))
  354. 4550  GOSUB 5060: GOSUB 5260
  355. 4560  RETURN 
  356. 4570  REM   *** SET-UP TO READ RPTFMTFILE ***
  357. 4580 F$ = RN$(NN) +".R"
  358. 4590  GOSUB 4890
  359. 4600 RH = (NR -2)/3: FOR I = 1 TO NR:K(I) =  VAL(R$(I)): NEXT I
  360. 4610 K(0) =  VAL(R$(I -2))
  361. 4620 NR = NS
  362. 4630  GOSUB 4640: PRINT : GOTO 3630
  363. 4640  REM *** SUB MENU ***
  364. 4650  HOME : PRINT "SELECT FROM:": PRINT 
  365. 4660  IF MF = 0  THEN  PRINT "0 "H$(0)
  366. 4670  FOR I = 1 TO NH: PRINT I" "H$(I): NEXT I: PRINT 
  367. 4680 MF = 0
  368. 4690  RETURN 
  369. 4700  REM  *** READ REPORTNAMEFILE & SELECT REPORT ***
  370. 4710 NN = 0: FOR I = 0 TO 21:RN$(I) = "": NEXT I:NS = NR
  371. 4720 F$ = ".F"
  372. 4730  ONERR  GOTO 4840
  373. 4740  GOSUB 4890
  374. 4750  POKE 216,0
  375. 4760  FOR I = 1 TO NR:RN$(I) = R$(I): NEXT I
  376. 4770  HOME : PRINT "SELECT FROM:": PRINT 
  377. 4780  FOR I = 1 TO NR: PRINT I" "R$(I): NEXT I: PRINT 
  378. 4790  PRINT I" CREATE A NEW REPORT FORMAT": PRINT 
  379. 4800  INPUT "WHICH ";S$:S =  VAL(S$): IF S <1  OR S >I  THEN 4800
  380. 4810 NN = S
  381. 4820  IF S < >I  THEN RN$(S) = R$(S):E = 1:NR = NS: GOTO 4570
  382. 4830  GOTO 4880
  383. 4840  PRINT D$"CLOSE": CALL 1013: HOME : PRINT "NO REPORT FORMATS ON DISK...": PRINT 
  384. 4850  POKE 216,0
  385. 4860 NN = 1
  386. 4870  INPUT "DO YOU WANT TO CREATE ONE (Y/N) ?";L$: IF L$ < >"Y"  THEN 5580
  387. 4880  GOSUB 4640:NR = NS: GOTO 3340
  388. 4890  REM  *** READ FILES ***
  389. 4900  IF F$ < >".I"  THEN FF = 1
  390. 4910  PRINT D$;"OPEN";DB$;F$;"F"
  391. 4920  PRINT D$;"READ";DB$;F$;"F"
  392. 4930  INPUT NR
  393. 4940  FOR J = 1 TO NR
  394. 4950  ON FF GOTO 5010
  395. 4960  FOR I = 1 TO NH
  396. 4970  INPUT N$(J,I)
  397. 4980  NEXT I
  398. 4990 R(J) = J
  399. 5000  GOTO 5020
  400. 5010  INPUT R$(J)
  401. 5020  NEXT J
  402. 5030  PRINT D$"CLOSE"
  403. 5040 FF = 0
  404. 5050  RETURN 
  405. 5060  REM  *** SAVE FILES ***
  406. 5070  IF F$ < >".I"  THEN FF = 1
  407. 5080  PRINT "WRITING..."
  408. 5090  PRINT D$"OPEN";DB$;F$;"F": PRINT D$"CLOSE"
  409. 5100  PRINT D$;"DELETE";DB$;F$;"F"
  410. 5110  PRINT D$"OPEN"DB$;F$"F"
  411. 5120  PRINT D$"WRITE"DB$;F$"F"
  412. 5130  PRINT NR
  413. 5140  FOR J = 1 TO NR
  414. 5150  ON FF GOTO 5210
  415. 5160 Y = R(J)
  416. 5170  FOR I = 1 TO NH
  417. 5180  PRINT N$(Y,I)
  418. 5190  NEXT I
  419. 5200  GOTO 5220
  420. 5210  PRINT R$(J)
  421. 5220  NEXT J
  422. 5230  PRINT D$"CLOSE"
  423. 5240 FF = 0
  424. 5250  RETURN 
  425. 5260  REM  *** SAVE REPORTNAMEFILE ***
  426. 5270 NR = NN
  427. 5280 F$ = ".F"
  428. 5290  FOR I = 1 TO NR:R$(I) = RN$(I): NEXT I
  429. 5300  GOSUB 5060
  430. 5310 NR = NS: RETURN 
  431. 5320  REM  *** LIST ***
  432. 5330 L = 0
  433. 5340  HOME 
  434. 5350  FOR J = 1 TO NR:Y = R(J)
  435. 5360  ON PF GOSUB 6060,6080,6110
  436. 5370  PRINT "  "H$(0)": ";J:L = L +1
  437. 5380  FOR I = 1 TO NH
  438. 5390  PRINT I" "H$(I)": "N$(Y,I)
  439. 5400 L = L +1
  440. 5410  NEXT I
  441. 5420  PRINT :L = L +1
  442. 5430  IF L +NH >20  THEN 5480
  443. 5440  NEXT J
  444. 5450  PRINT D$"PR#0"
  445. 5460  INPUT "HIT RETURN FOR MENU...";L$
  446. 5470  GOTO 5580
  447. 5480  PRINT D$"PR#0"
  448. 5490  PRINT "PRESS RETURN TO CONTINUE, ESC FOR MENU";
  449. 5500  GET L$
  450. 5510  IF  ASC(L$) = 27  THEN 5580
  451. 5520  IF  ASC(L$) = 13  THEN 5540
  452. 5530  GOTO 5500
  453. 5540  HOME :L = 0
  454. 5550  ON PF GOSUB 6060,6080,6110
  455. 5560  GOTO 5440
  456. 5570  STOP 
  457. 5580  REM *** MAIN MENU ***
  458. 5590  GOTO 5610
  459. 5600  PRINT D$"CLOSE": CALL 1013
  460. 5610  HOME 
  461. 5620  PRINT "******* PRODOS FILE CABINET *******"
  462. 5630  PRINT : PRINT "DATE: ";
  463. 5640  IF DD = 0  THEN  PRINT "<NO DATE>": GOTO 5690
  464. 5650  IF DD <10  THEN  PRINT "0";
  465. 5660  PRINT DD;"-";MM$;"-";
  466. 5670  IF YY <10  THEN  PRINT "0";
  467. 5680  PRINT YY
  468. 5690  PRINT 
  469. 5700  PRINT "CURRENT DATA BASE: "DB$: PRINT 
  470. 5710  PRINT "CURRENTLY CONTAINS: "NR" RECORDS": PRINT : PRINT "YOU HAVE ";: GOSUB 8000: PRINT FM;" BYTES OF MEMORY LEFT"
  471. 5730  PRINT 
  472. 5740  IF PF > = 1  THEN  PRINT "THE PRINTER IS ";: FLASH : PRINT "ON": NORMAL : GOTO 5760
  473. 5750  PRINT "THE PRINTER IS OFF"
  474. 5760  PRINT 
  475. 5770  PRINT "1  SELECT DATA BASE"
  476. 5780  PRINT "2  SEARCH AND/OR CHANGE DATA"
  477. 5790  PRINT "3  ENTER RECORDS"
  478. 5800  PRINT "4  DELETE RECORDS"
  479. 5810  PRINT "5  REPORT"
  480. 5820  PRINT "6  SORT (SAVES TO DISK)"
  481. 5830  PRINT "7  TURN ON PRINTER"
  482. 5840  PRINT "8  TURN OFF PRINTER"
  483. 5850  PRINT "9  LIST ALL RECORDS"
  484. 5860  PRINT "10 QUIT"
  485. 5870  REM GET MENU SELECTION
  486. 5880  VTAB 23: HTAB 20: INPUT "WHICH ";S$:S =  VAL(S$)
  487. 5890  IF S <1  OR S >10  THEN 5580
  488. 5900  ON S GOTO 1040,1910,1710,2520,3260,1520,5910,5990,5320,6000
  489. 5910  HOME 
  490. 5920  PRINT "PRINTER OPTIONS:"
  491. 5930  PRINT "1 40 COLUMNS"
  492. 5940  PRINT "2 80 COLUMNS"
  493. 5950  PRINT "3 132 COLUMNS"
  494. 5960  PRINT : INPUT "WHICH ";PF$:PF =  VAL(PF$)
  495. 5970  IF PF <1  OR PF >3  THEN 5960
  496. 5980  GOTO 5580
  497. 5990 PF = 0: GOTO 5580
  498. 6000  PRINT D$"CLOSE": END 
  499. 6010  REM  *** APPLESOFT ONERR CORRECTION
  500. 6020  FOR I = 1013 TO 1022: READ PP: POKE I,PP: NEXT I
  501. 6030 I = 0
  502. 6040  RETURN 
  503. 6050  DATA 104,168,104,166,223,154,72,152,72,96
  504. 6060  PRINT D$"PR#1"
  505. 6070  PRINT I$;"40N": RETURN 
  506. 6080  PRINT D$"PR#1"
  507. 6090  PRINT I$;"80N"
  508. 6100  RETURN 
  509. 6110  PRINT D$"PR#1"
  510. 6120  PRINT I$;"132N"
  511. 6130  RETURN 
  512. 8000  PRINT  CHR$(4)"FRE":FM = ( PEEK(111) + PEEK(112) *256) -( PEEK(109) + PEEK(110) *256): RETURN 
  513. 65535  REM "<CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H><CTRL-H>*                  <CTRL-M>* APPLE COMPUTER'S<CTRL-M>* FILE.CABINET<CTRL-M>*<CTRL-M>* 1ST UPDATE BY:<CTRL-M>* JAC M PILTZ 1980<CTRL-M>*<CTRL-M>* 2ND UPDATE AND<CTRL-M>* CONVERSION TO<CTRL-M>* PRODOS BY:<CTRL-M>* JAMES M LUTHER 4/84<CTRL-M>*